home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1997
/
HAM Radio 1997.iso
/
vcls
/
stabaru
/
statbaru.pas
next >
Wrap
Pascal/Delphi Source File
|
1996-04-08
|
9KB
|
282 lines
unit Statbaru;
interface
{ -********************************************- }
{ - Authored: ---------------------------------- }
{ - 5-16-95 By Eric Uber. CIS Address 71102,3034 }
{ - All rights reserved. }
{ -********************************************- }
{ ---------------------------------------------- }
{ Directions: }
{ 1. Install. }
{ 2. Drop on form. }
{ 3. Set the UpdateInterval property. }
{ 4. Set Enabled property to True; }
{ ---------------------------------------------- }
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, extctrls;
const
defHeight: integer = 25;
defWidth: integer = 100;
defUpdateIntr: integer = 1000;
type
TSectionBevels = (sbLow,sbLowest,sbHigh,sbHighest,sbIsUpDown,sbIsDownUp,sbNone);
TMyCustomPanel = class(TCustomPanel)
private
procedure WMLButtonDown(var msg: TMessage); message wm_LButtonDown;
protected
property BevelInner;
property BevelOuter;
end;
TEStatusBar = class(TMyCustomPanel)
private
{ Private declarations }
FSectionDateBevel : TSectionBevels;
FSectionTimeBevel : TSectionBevels;
FSectionMainBevel : TSectionBevels;
FAlignTime : TAlign;
FAlignDate : TAlign;
FWidthTime : integer;
FWidthDate : integer;
FEnabled : Boolean;
FOnTimer : TNotifyEvent;
FUpdateInterval : integer;
protected
{ Protected declarations }
pnlDate: TMyCustomPanel;
pnlTime: TMyCustomPanel;
procedure SetFSectionMainBevel(Bev: TSectionBevels);
procedure SetFSectionDateBevel(Bev: TSectionBevels);
procedure SetFSectionTimeBevel(Bev: TSectionBevels);
procedure SetFEnabled(bIsEnabled: Boolean);
procedure SetFAlignTime(oAlign:TAlign);
procedure SetFAlignDate(oAlign:TAlign);
procedure SetBevels(oCaller: TCustomPanel; Prop: TSectionBevels);
procedure SetFWidthTime(iVal: integer);
procedure SetFWidthDate(iVal: integer);
procedure SetFUpdateInterval(iVal: integer);
procedure WMTimer(var msg: TWMTimer); message wm_Timer;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
published
{ Published declarations }
property SectMainBevel: TSectionBevels read FSectionMainBevel
write SetFSectionMainBevel;
property SectDateBevel: TSectionBevels read FSectionDateBevel
write SetFSectionDateBevel;
property SectTimeBevel: TSectionBevels read FSectionTimeBevel
write SetFSectionTimeBevel;
property AlignTime: TAlign read FAlignTime write SetFAlignTime;
property AlignDate: TAlign read FAlignDate write SetFAlignDate;
property Align;
property Caption;
property WidthTime: integer read FWidthTime write SetFWidthTime
default 100; {defWidth}
property WidthDate: integer read FWidthDate write SetFWidthDate
default 100; {defWidth}
property Enabled: Boolean read FEnabled write SetFEnabled;
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
property UpdateInterval: integer read FUpdateInterval write SetFUpdateInterval
default 1000;{defUpdateIntr}
property Font;
property ParentFont;
end;
procedure Register;
{ -********************************************- }
{ - Begin Implimentation **********************- }
{ -********************************************- }
implementation
{-----------------------------------------------}
{-----------------------------------------------}
procedure Register;
begin
RegisterComponents('Custom', [TEStatusBar]);
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
constructor TEStatusBar.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := defHeight;
Align := alBottom;
pnlDate:= TMyCustomPanel.Create(nil);
with pnlDate do
begin
Parent := Self;
ParentFont := True;
BevelOuter := bvLowered;
BevelInner := bvNone;
end;
pnlTime:= TMyCustomPanel.Create(nil);
with pnlTime do
begin
Parent := Self;
ParentFont := True;
BevelOuter := bvLowered;
BevelInner := bvNone;
end;
WidthTime := defWidth;
WidthDate := defWidth;
AlignDate := alLeft;
AlignTime := alLeft;
SectDateBevel := sbLow;
SectTimeBevel := sbLow;
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFSectionMainBevel(Bev: TSectionBevels);
begin
FSectionMainBevel := Bev;
SetBevels(self,FSectionMainBevel);
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFSectionDateBevel(Bev: TSectionBevels);
begin
FSectionDateBevel := Bev;
SetBevels(pnlDate,FSectionDateBevel);
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFSectionTimeBevel(Bev: TSectionBevels);
begin
FSectionTimeBevel := Bev;
SetBevels(pnlTime,FSectionTimeBevel);
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetBevels(oCaller: TCustomPanel; Prop: TSectionBevels);
begin
case Prop of
sbHighest:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvRaised;
(oCaller as TMyCustomPanel).BevelInner := bvRaised;
end;
sbLowest:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvLowered;
(oCaller as TMyCustomPanel).BevelInner := bvLowered;
end;
sbNone:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvNone;
(oCaller as TMyCustomPanel).BevelInner := bvNone;
end;
sbIsUpDown:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvRaised;
(oCaller as TMyCustomPanel).BevelInner := bvLowered;
end;
sbIsDownUp:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvLowered;
(oCaller as TMyCustomPanel).BevelInner := bvRaised;
end;
sbLow:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvLowered;
(oCaller as TMyCustomPanel).BevelInner := bvNone;
end;
sbHigh:
begin
(oCaller as TMyCustomPanel).BevelOuter := bvRaised;
(oCaller as TMyCustomPanel).BevelInner := bvNone;
end;
end; { End Case. }
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TMyCustomPanel.WMLButtonDown(var msg: TMessage);
begin
inherited;
SendMessage(Parent.Handle,wm_LButtonDown,msg.wParam,msg.LParam);
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFAlignTime(oAlign:TAlign);
begin
FAlignTime := oAlign;
pnlTime.Align := oAlign;
end; { End proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFAlignDate(oAlign: TAlign);
begin
FAlignDate := oAlign;
pnlDate.Align := oAlign;
end; { End Proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFWidthTime(iVal: integer);
begin
FWidthTime := iVal;
pnlTime.Width := iVal;
end; { End Proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFWidthDate(iVal: integer);
begin
FWidthDate := iVal;
pnlDate.Width := iVal;
end; { End Proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFEnabled(bIsEnabled: Boolean);
begin
FEnabled := bIsEnabled;
if (bIsEnabled) then
Settimer(Self.Handle,Self.Handle,FUpdateInterval,nil)
else
KillTimer(Self.Handle,Self.Handle);
end; { End Proc }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.WMTimer(var msg: TWMTimer);
begin
inherited;
if ( Assigned(FOnTimer)) then
FOnTimer(self);
pnlDate.Caption := DateToStr(Date);
pnlTime.Caption := TimeToStr(Time);
end; { End Proc. }
{-----------------------------------------------}
{-----------------------------------------------}
procedure TEStatusBar.SetFUpdateInterval(iVal: integer);
begin
FUpdateInterval := iVal;
Enabled := False;
Enabled := True;
end; { End Proc. }
end. { End unit. }